home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / addico1a / form1.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-10-07  |  4.5 KB  |  147 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    Caption         =   "Form1"
  4.    ClientHeight    =   1725
  5.    ClientLeft      =   165
  6.    ClientTop       =   735
  7.    ClientWidth     =   4680
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   1725
  10.    ScaleWidth      =   4680
  11.    StartUpPosition =   3  'Windows Default
  12.    Begin VB.Image imgDelete 
  13.       Height          =   240
  14.       Left            =   3600
  15.       Picture         =   "Form1.frx":0000
  16.       Top             =   960
  17.       Visible         =   0   'False
  18.       Width           =   750
  19.    End
  20.    Begin VB.Image imgExit 
  21.       Height          =   240
  22.       Left            =   2640
  23.       Picture         =   "Form1.frx":0242
  24.       Top             =   960
  25.       Visible         =   0   'False
  26.       Width           =   540
  27.    End
  28.    Begin VB.Image imgCaution 
  29.       Height          =   240
  30.       Left            =   2640
  31.       Picture         =   "Form1.frx":0944
  32.       Top             =   600
  33.       Visible         =   0   'False
  34.       Width           =   825
  35.    End
  36.    Begin VB.Image imgYield 
  37.       Height          =   240
  38.       Left            =   1800
  39.       Picture         =   "Form1.frx":0B86
  40.       Top             =   960
  41.       Visible         =   0   'False
  42.       Width           =   645
  43.    End
  44.    Begin VB.Image imgStop 
  45.       Height          =   240
  46.       Left            =   1800
  47.       Picture         =   "Form1.frx":0D88
  48.       Top             =   600
  49.       Visible         =   0   'False
  50.       Width           =   615
  51.    End
  52.    Begin VB.Menu mnuFile 
  53.       Caption         =   "&File"
  54.       Begin VB.Menu mnuFileExit 
  55.          Caption         =   "E&xit"
  56.       End
  57.    End
  58.    Begin VB.Menu mnuData 
  59.       Caption         =   "&Data"
  60.       Begin VB.Menu mnuDataDelete 
  61.          Caption         =   "&Delete"
  62.       End
  63.       Begin VB.Menu mnuDataOptions 
  64.          Caption         =   "&Options"
  65.          Begin VB.Menu mnuDataOptionsStop 
  66.             Caption         =   "Stop"
  67.          End
  68.          Begin VB.Menu mnuDataOptionsYield 
  69.             Caption         =   "Yield"
  70.          End
  71.          Begin VB.Menu mnuDataOptionsCaution 
  72.             Caption         =   "Caution"
  73.          End
  74.       End
  75.    End
  76. Attribute VB_Name = "Form1"
  77. Attribute VB_GlobalNameSpace = False
  78. Attribute VB_Creatable = False
  79. Attribute VB_PredeclaredId = True
  80. Attribute VB_Exposed = False
  81. Option Explicit
  82. ' API stuff for putting bitmaps in menus.
  83. Private Type MENUITEMINFO
  84.     cbSize As Long
  85.     fMask As Long
  86.     fType As Long
  87.     fState As Long
  88.     wid As Long
  89.     hSubMenu As Long
  90.     hbmpChecked As Long
  91.     hbmpUnchecked As Long
  92.     dwItemData As Long
  93.     dwTypeData As Long
  94.     cch As Long
  95. End Type
  96. Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
  97. Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
  98. Private Declare Function SetMenuItemInfo Lib "user32" Alias "SetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal bypos As Long, lpcMenuItemInfo As MENUITEMINFO) As Long
  99. Private Const MF_BITMAP = &H4&
  100. Private Const MFT_BITMAP = MF_BITMAP
  101. Private Const MIIM_TYPE = &H10
  102. Private Sub Form_Load()
  103.     ' Set the menu bitmaps.
  104.     SetMenuBitmap Me, Array(0, 0), imgExit.Picture
  105.     SetMenuBitmap Me, Array(1, 0), imgDelete.Picture
  106.     SetMenuBitmap Me, Array(1, 1, 0), imgStop.Picture
  107.     SetMenuBitmap Me, Array(1, 1, 1), imgYield.Picture
  108.     SetMenuBitmap Me, Array(1, 1, 2), imgCaution.Picture
  109. End Sub
  110. ' Put a bitmap in a menu item.
  111. Public Sub SetMenuBitmap(ByVal frm As Form, ByVal item_numbers As Variant, ByVal pic As Picture)
  112. Dim menu_handle As Long
  113. Dim i As Integer
  114. Dim menu_info As MENUITEMINFO
  115.     ' Get the menu handle.
  116.     menu_handle = GetMenu(frm.hwnd)
  117.     For i = LBound(item_numbers) To UBound(item_numbers) - 1
  118.         menu_handle = GetSubMenu(menu_handle, item_numbers(i))
  119.     Next i
  120.     ' Initialize the menu information.
  121.     With menu_info
  122.         .cbSize = Len(menu_info)
  123.         .fMask = MIIM_TYPE
  124.         .fType = MFT_BITMAP
  125.         .dwTypeData = pic
  126.     End With
  127.     ' Assign the picture.
  128.     SetMenuItemInfo menu_handle, _
  129.         item_numbers(UBound(item_numbers)), _
  130.         True, menu_info
  131. End Sub
  132. Private Sub mnuDataDelete_Click()
  133.     MsgBox "Delete"
  134. End Sub
  135. Private Sub mnuDataOptionsCaution_Click()
  136.     MsgBox "Caution"
  137. End Sub
  138. Private Sub mnuDataOptionsStop_Click()
  139.     MsgBox "Stop"
  140. End Sub
  141. Private Sub mnuDataOptionsYield_Click()
  142.     MsgBox "Yield"
  143. End Sub
  144. Private Sub mnuFileExit_Click()
  145.     Unload Me
  146. End Sub
  147.